Collection of Tools & Utilities/Collection of Tools and Utilities.iso/basic/spllib.zip/PREDITOR.SP

Text File | 1988-04-06 | 22KB | 703 lines

BEGIN
     { Preditor : Program editor }

     { This program is written in The Structured Programming Language.
     You need to obtain the Structured Programming Language processor
     and process this program with it. A BASIC program will result and
     you will need to sort the program using SORT.EXE and then compile
     the program using any BASIC compiler. This program will run on
     MSDOS, PCDOS, or where there is compiled BASIC, such as on AMIGA,
     MACINTOSH, ATARI ST. You first must translate the program on MSDOS
     or PCDOS. You can obtain the Structured Programming Language from
     PC SIG at 800 245 6717, ask for DISK 666.
     Softdisk at 800 831 2694, ask for BIG BLUE DISK issue #16.
     Public Brand Software at 800 426 3475, ask for DISK BA-9.
     You can also get file SPLLIB.ARC from bbs systems at 800 632 7227,
     516 561 6590, and 516 334 8221. SPL is also known as file SPL.ARC
     and can be gotten from bbs systems at 800 365 6262 and 800 323 7464.
     This program PREDITOR and The Structured Programming Language are
     both shareware. Certainly if you use the SPL processor to create
     a running program out of PREDITOR, then you should register both
     The SPL processor and this program, PREDITOR if you use them and
     like them. If you have questions, call me, Dennis Baer at work at
     516 694 5872. }

     INTEGER Found,                 { Sucessful find }
             I,J,                   { Counters }
             Character_pointer,     { Character pointer }
             Result,                { Result }
             File_open,             { File open }
             Current_line,          { Current line in file }
             Output_mode,           { Output mode }
             LE;                    { Logical end of file }

     STRING L,                { File record }
            Change_delimiter, { Delimiter used in the change command. }
            Ifile;            { Input file name. }

     INTEGER ARRAY PT(4000);  { Record pointers }

     STRING ARRAY OF(4000);  { File records }

     PROCEDURE INITIALIZE;   { Initialize file arrays, output messages. }
     BEGIN
          OUTPUT('*** PREDITOR version 1.0 ***');
          OUTPUT('    (c) Dennis Baer 1988');
          OPEN('LPT1:' FOR OUTPUT AS #7);  { Open printer }
          File_open := 0;  { File open set to zero, file not open }
          Change_delimiter := '!'; { Set default change delimiter }
          FOR I := 1 STEP 1 UNTIL 4000 DO
          BEGIN
               PT(I) := 0;  { Set pointer to record as null }
               OF(I) := ''; { Set record null }
          END
     END

     INTEGER LOW,HIGH,Low_line,High_line; { Line number variables }

     PROCEDURE OUTSCREEN(LOW,HIGH);
     BEGIN
          IF HIGH=0 THEN
          BEGIN
               OUTPUT('<' @ LOW @ '>' @ OF(PT(LOW)));
               Current_line := LOW;
               RETURN;
          END
          FOR I:= LOW STEP 1 UNTIL HIGH DO
          BEGIN
               OUTPUT('<' @ I @ '>' @ OF(PT(I)));
          END
          Current_line := HIGH;
     END

     PROCEDURE OUTPRINTER(LOW,HIGH);
     BEGIN
          FOR I:= LOW STEP 1 UNTIL HIGH DO
          BEGIN
               L := OF(PT(I));
               OUTPUT(#7, MID$(L,1,80));
               IF LEN(L) > 80 THEN
               BEGIN
                    L := MID$(L,81); OUTPUT(#7,L);
               END
          END
          Current_line := HIGH; OUTPUT();
     END

     STRING Search_string, Replace_string;

     PROCEDURE FIND(Search_string);
     BEGIN
          Found := 0;
          FOR J := Current_line STEP 1 UNTIL LE DO
          BEGIN
               Character_pointer := INSTR( OF(PT(J)), Search_string );
               IF Character_pointer <> 0 THEN
               BEGIN
                    Current_line := J;
                    Found := 1; RETURN;
               END
          END
          Current_line := 1;
     END

     PROCEDURE CHANGE(Search_string,Replace_string);
     BEGIN
          STRING Part_1, Part_2, Part_3;

          Found := 0;
          Character_pointer := INSTR( OF(PT(Current_line)), Search_string );
          IF Character_pointer = 0 THEN RETURN;
          IF Character_pointer = 1 THEN
          BEGIN
               Part_1 := '';
          END

          ELSE
          BEGIN
               Part_1 := LEFT$( OF(PT(Current_line)), Character_pointer-1 );
          END

          IF ( Character_pointer - 1 + LEN(Search_string) ) >
             LEN(OF(PT(Current_line))) THEN
          BEGIN
               Part_3 := '';
               Part_2 := Replace_string;
               OF(PT(Current_line)) := Part_1 + Part_2 + Part_3;
               Found := 1;
               OUTSCREEN(Current_line,0);
               RETURN;
          END

          ELSE
          BEGIN
               Part_3 := MID$( OF(PT(Current_line)), Character_pointer +
                                                     LEN(Search_string) );
               Part_2 := Replace_string;
               OF(PT(Current_line)) := Part_1 + Part_2 + Part_3;
               Found := 1;
               OUTSCREEN(Current_line,0);
               RETURN;
          END
     END

     PROCEDURE DELETE_LINES(LOW,HIGH);
     BEGIN
          INTEGER Temp;

          Temp := LOW;
          IF HIGH = 0 THEN HIGH := LOW;
          FOR J := LOW STEP 1 UNTIL HIGH DO
          BEGIN
               OF(PT(J)) := ''; PT(J) := 0;
          END
          IF HIGH < LE THEN
          BEGIN
               FOR J := HIGH + 1 STEP 1 UNTIL LE DO
               BEGIN
                    PT(Temp) := PT(J);
                    PT(J) := 0;
                    Temp := Temp + 1;
               END
          END
          Current_line := 1; LE := LE - (HIGH-LOW+1);
     END

     STRING Line;

     PROCEDURE INPUTLINE(Line);
     BEGIN
          INTEGER Temp;

          FOR I := 1 STEP 1 UNTIL 4000 DO
          BEGIN
               IF OF(I) = '' THEN
               BEGIN
                    Temp := I;
                    GO TO Found_blank;
               END
          END
          Found := 0;
          RETURN;

Found_blank:

          Found := 1;
          IF PT(1) = 0 THEN
          BEGIN
               Current_line := 1; LE := 1; PT(1) := Temp;
               OF(PT(1)) := Line; RETURN;
          END

          FOR I := LE + 1 STEP -1 UNTIL Current_line + 2 DO
          BEGIN
               IF LE = Current_line THEN GO TO Done_shifting;
               PT(I) := PT(I-1);
          END

Done_shifting:

          PT(Current_line + 1) := Temp; LE := LE + 1;
          OF(PT(Current_line + 1)) := Line;
          Current_line := Current_line + 1;
     END

     STRING File; { File name of open file. }

     PROCEDURE OPENFILE(File);
     BEGIN
          INTEGER Temp;

          IF File_open = 1 THEN
          BEGIN
               Result := 0;
               RETURN;
          END

          ONERRGOTO File_open_error;

          OPEN( File FOR INPUT AS #1 );

          ONERRGOTO File_read_error;

          FOR I := 1 STEP 1 UNTIL 4000 DO
          BEGIN
               IF EOF(1) THEN GO TO Success; { End of file. }
               LINEIN( #1,L); { Read record. }
               IF L = '' THEN L := ' '; { Null line set to a blank }
               PT(I) := I; OF(I) := L; Temp := I;
          END

Success:  CLOSE(#1); Result := 1; File_open := 1; { Set file open. }
          LE := Temp; Current_line := 1;
          RETURN;

File_open_error: Result := 0; OUTPUT('*** Error, opening file: ' @ File @
                                    ' ***');
          RESUME Finish_open;

File_read_error: Result := 0; OUTPUT('*** Error, reading file: ' @ File @
                                    ' ***');
          RESUME Finish_open;

Finish_open:

     END

     PROCEDURE SAVEFILE(File);  { Save text file. }
     BEGIN
          { If file is not open and no file name is given
            give error code